BBS Toolkit/BBS Toolkit.iso/gt_power/gtuser11.zip/GTUSER.PAS

Pascal/Delphi Source File | 1991-02-06 | 10KB | 371 lines

unit GTUser;
{ A unit to parse the GT Powercomm GTUSER.BBS file and provide a
  pre-digested record for door or companion programs. This should save
  writers of such utilities considerable "wheel-reinventing".

  It is current as at the format used by GT 16 and is backward-compatible
  with earlier releases.

  Copyright (C) Ted Harper 1990-91

  but free distribution of _unmodified_ source and generated code permitted.

  Amendments :-
  -------------
  Corrected bug where date is preceded by _two_ blanks             t.h. 2/91
  Stopped using "FSearch" builtin because of undocumented feature  t.h. 2/91
}

interface
const
   GTUSER_Name_Length = 32;

type
   GTUSER_Name_Type = string[GTUSER_Name_Length];

   GTUSER_Date_Type = record
      YYYY : word;
      MM,
      DD : byte
      end;

   GTUSER_Time_Type = record
      HH,
      MM,
      SS : byte
      end;

   GTUSER_Timelimit_Type = integer;

   Authorisations = (
      UP,      { Uploads permitted }
      DN,      { Downloads permitted }
      PR,      { Private mail may be entered }
      KL,      { Can K)ill messages like sysop }
      SY,      { SYSOP }
      CH,      { Manual dir. change allowed (if GTDIR.BBS not in use) }
      SH,      { Shell to DOS allowed }
      DR,      { Use of DOORs by user OK }
      MS,      { Messages may be read }
      FA,      { Allow FileAttach when netmailing }
      FR,      { Allow FileRequest when netmailing }
      NL,      { Disable L)ist directory main menu option }
      NE,      { Disable E)nter message command }
      CB,      { CB simulator use allowed }
      NP,      { Sysop page _not_ allowed }
      DX);     { Delivery (??) allowed }

   Authorisation_Set = set of Authorisations;

   GTUSER_BBS_Details = record
      Level : char;
      First_Name,
      Last_Name : GTUSER_Name_Type;
      Authorisation : Authorisation_Set;
      DCE_Baud,
      DTE_Baud : word; { 0 = local }
      Ansi_Opt : boolean;
      Date_Last_On : GTUSER_Date_Type;
      Limit,
      Event : GTUSER_TimeLimit_Type;
      Current_Time : GTUSER_Time_Type
      end;

procedure GetGTUserDetails(var GBD : GTUSER_BBS_Details);

implementation

uses
   DOS;

const
   GTUSER_BBS_FileName = 'GTUSER.BBS';

   GTUSER_BBS_Length = 250;

   GTUSER_Word_Length = 60;
   GTUSER_Word_array_Limit = 12;

type
   GTUSER_BBS_Rec_Type = string[GTUSER_BBS_Length];

   GTUSER_Word = string[GTUSER_Word_Length];
   GTUSER_Word_Array_Type = array [1..GTUSER_Word_Array_Limit] of GTUSER_Word;

var
   GTUSER_BBS_File : text;

   GTUSER_BBS_Rec : GTUSER_BBS_Rec_Type;


procedure Get_File_Details(var G : GTUSER_BBS_Rec_Type);
{ Find the GTUSER.BBS file and read into "G" }
var
   GTPath, GTUSERBBS_PATH : PathStr;
begin
   { Find GTUSER.BBS in the directory pointed to by GTPATH }
   GTPath := getenv('GTPATH');
   if GTPath = ''
   then begin
      writeln('GTUSER : Can''t find GTPATH environment variable');
      halt(1)
      end;

   if copy(GTPath,length(GTPath),1) <> '\'
   then
      GTPath := GTPath + '\';

   GTUSERBBS_PATH := GTPath + GTUSER_BBS_FileName;

   assign(GTUSER_BBS_File,GTUSERBBS_PATH);
   {$I-}
   reset(GTUSER_BBS_File);
   {$I+}
   if IOResult <> 0
   then begin
      writeln('GTPATH : GTUSER.BBS could not be found in GTPATH directory');
      halt(1)
      end;

   readln(GTUSER_BBS_File,G);
   close(GTUSER_BBS_File)
end; { Get_File_Details }


procedure Break_Into_Words(GBR : GTUSER_BBS_Rec_Type;
                           var Words : GTUSER_Word_Array_Type);
var
   i : byte;
   WordIndex : byte;
begin
   WordIndex := 0;
   for i := 1 to GTUSER_Word_array_Limit
   do
      Words[i] := '';
   i := 1;

   while ((i <= length(GBR)) and (WordIndex < GTUSER_Word_array_limit))
   do begin
      { Get a complete "word" - delimited by space or eoln }
      inc(WordIndex);
      while ((i <= length(GBR)) and (GBR[i] <> ' '))
      do begin
         Words[WordIndex] := Words[WordIndex] + GBR[i];
         inc(i);
         end;
      { End of word has been reached - skip past spaces }
      while ((i <= length(GBR)) and (GBR[i] = ' '))
      do
         inc(i)
      end
end; { Break_Into_Words }


procedure Get_Authorisation(User_Auth : GTUSER_Word;
                            var AS : Authorisation_Set);
{ Parse string of all authorisations given to the current user and
  return a set of authorisations. }
const
   Num_Auths = 16;

   AU_Str : array[1..Num_Auths] of string[2] =
     ('UP','DN','PR','KL','SY','CH','SH','DR','MS','FA',
      'FR','NL','NE','CB','NP','DX');
   AU_Val : array[1..Num_Auths] of Authorisations =
     ( UP , DN , PR , KL , SY , CH , SH , DR , MS , FA ,
       FR , NL , NE , CB , NP , DX );
var
   i : byte;
begin
   AS := [];

   for i := 1 to Num_Auths
   do begin
      if pos(AU_Str[i],User_Auth) > 0
      then
         AS := AS + [(AU_Val[i])]
      end
end; { Get_Authorisation }


procedure Get_Baud(User_Baud : GTUSER_Word;
                   var DCE_Baud, DTE_Baud : word);
{ Get current user's baud rate and return as numeric (LOCAL = 0) }
var
   Comma_Pos : byte;
   Temp_Word : GTUSER_Word;
   code : integer;
begin
   if User_Baud = 'LOCAL'
   then begin
      DCE_Baud := 0;
      DTE_Baud := 0
      end
   else begin
      { With latest GT host changes, both DCE and DTE baud rates are
        returned separated by a comma }
      Comma_Pos := pos(',',User_Baud);
      if Comma_Pos = 0
      then begin
         { Earlier version of GT - only one value returned, assume same for
           DCE and DTE }
         val(User_Baud,DCE_Baud,Code);
         if Code <> 0
         then
            DCE_Baud := 0;
         DTE_Baud := DCE_Baud
         end
      else begin
         { If there is a comma in the string, then _two_ numbers are there }

         { Get first number (DTE baud) and convert to numeric }
         Temp_Word := copy(User_Baud,1,pred(Comma_Pos));
         val(Temp_Word,DTE_Baud,Code);
         if Code <> 0
         then
            DTE_Baud := 0;

         { Get second number (DCE baud) and convert to numeric }
         Temp_Word := copy(User_Baud,succ(Comma_Pos),
                         length(User_Baud)-Comma_Pos);
         val(Temp_Word,DCE_Baud,Code);
         if Code <> 0
         then
            DCE_Baud := 0
         end
      end
end; { Get_Baud }


procedure Get_Last_Date(Date_Str : GTUSER_Word;
                        var Last_Date : GTUSER_Date_Type);
{ Parse date into years, months and days (separately) and return as such }
const
   DATE_DELIMITER = '-';
var
   Work_Date, Temp_Str : string;
   Month_End, Day_End : byte;
   code : integer;
begin
   with Last_Date
   do begin
      YYYY := 0;
      MM := 0;
      DD := 0
      end;

   Work_Date := Date_Str;

   { Months are the part up to the first '-' }
   Month_End := pos(DATE_DELIMITER,Work_Date);
   { grab characters up to (not including) the '-' }
   Temp_Str := copy(Work_Date,1,pred(Month_End));
   { Delete MM- from string }
   delete(Work_Date,1,Month_End);
   { Convert month to numeric }
   val(Temp_Str,Last_Date.MM,code);

   { Extract DD part of date }
   Day_End := pos(DATE_DELIMITER,Work_Date);
   { grab characters up to (not including) the '-' }
   Temp_Str := copy(Work_Date,1,pred(Day_End));
   { Delete DD- from string }
   delete(Work_Date,1,Day_End);
   { Convert day to numeric }
   val(Temp_Str,Last_Date.DD,code);

   { Remainder should be year as YY }
   val(Work_Date,Last_Date.YYYY,code);
   if Last_Date.YYYY < 100
   then
      { expand year to 19xx }
      inc(Last_Date.YYYY,1900);

end; { Get_Last_Date }


procedure Get_Timelimit(Limit_Str : GTUSER_Word;
                        var Limit_Num : GTUSER_Timelimit_Type);
{ Convert a time limit from a string to a usable numeric format }
var
   code : integer;
begin
   val(Limit_Str,Limit_Num,code);
   if code <> 0
   then begin
      { Should HALT here! }
      Limit_Num := 0
      end
end; { Get_TimeLimit }


procedure Get_Current_Time(Time_Str : GTUSER_Word;
                        var Curr_Time : GTUSER_Time_Type);
{ Parse time into hours, minutes and seconds (separately) and return as such }
const
   TIME_DELIMITER = ':';
var
   Work_Time, Temp_Str : string;
   Hour_End : byte;
   code : integer;

begin
   with Curr_Time
   do begin
      HH := 0;
      MM := 0;
      SS := 0;
      end;

   Work_Time := Time_Str;

   { Extract HH part of time }
   Hour_End := pos(TIME_DELIMITER,Work_Time);
   { grab characters up to (not including) the ':' }
   Temp_Str := copy(Work_Time,1,pred(Hour_End));
   { Delete HH- from string }
   delete(Work_Time,1,Hour_End);
   { Convert hours to numeric }
   val(Temp_Str,Curr_Time.HH,code);

   { Remainder should be minutes as MM }
   val(Work_Time,Curr_Time.MM,code)
end; { Get_Current_Time }


procedure GetGTUserDetails(var GBD : GTUSER_BBS_Details);
{ Locate the GTUSER.BBS file and extract user details, parse and digest,
  return the details to the caller.
}
var
   GTUSER_Word_Array : GTUSER_Word_Array_Type;
begin
   { Locate GTUSER.BBS and read into a one-line record }
   Get_File_Details(GTUSER_BBS_Rec);

   { Break input record into "words" to make later processing easier }
   Break_into_Words(GTUSER_BBS_Rec,GTUSER_Word_Array);

   { simple string->string assignments }
   GBD.Level      := GTUSER_Word_Array[1][1];
   GBD.First_Name := GTUSER_Word_Array[2];
   GBD.Last_Name  := GTUSER_Word_Array[3];

   Get_Authorisation(GTUSER_Word_Array[4],GBD.Authorisation);

   Get_Baud(GTUSER_Word_Array[5],GBD.DCE_Baud,GBD.DTE_Baud);

   GBD.Ansi_Opt := GTUSER_Word_Array[6] = 'ANSI';

   Get_Last_Date(GTUSER_Word_Array[7],GBD.Date_Last_On);

   Get_TimeLimit(GTUSER_Word_Array[8],GBD.Limit);
   Get_TimeLimit(GTUSER_Word_Array[9],GBD.Event);

   Get_Current_Time(GTUSER_Word_Array[10],GBD.Current_Time)

end; { GetGTUserDetails }


begin
end.